#!/usr/bin/perl -w
use strict;

# Settings for run1: 
# Abstracts + Experimental methods tagging using dictionary as it is
# High precision results.
my $file_dir = $ARGV[0];
my $abstract = $ARGV[1];
my $dict_file = "BC3_data/BC3_IMT_Training/annotations/allowed_PSI-MI_ids_and_synonyms.txt";

open (WR, ">log_tagging");

# Read term dictionary and various attributes of the terms
my @dict_words;
my %id_concept;
my %term_ids;
my %term_concepts;
my %term_inserted;
&read_dictionary;

opendir(DIR, $file_dir) ||
	die ("Unable to open: $file_dir\n");
my @files = grep {(!/^\./)} readdir(DIR);
closedir (DIR);

for (my $k = 0; $k < scalar(@files); $k++){ 
	print WR "Processing " . $file_dir . "/" . $files[$k] . "\n";
	if ($abstract == 0){
		&tag_methods ($files[$k]);
	} elsif ($abstract == 1) { 
		&tag_abstract ($files[$k]);
	} elsif ($abstract == 2) { 
		&tag_article ($files[$k]);
	}	
}

sub tag_abstract{ 
	my ($file) = @_;
	my $path = $file_dir . "/" . $file;
	open (FD, $path) ||
		die ("Unable to open: $path\n");
	while (<FD>){ 
		chop;
		$_ =~ s/^\ +//g;
		next if (not ($_ =~ /^\<AbstractText\>/ or $_ =~ /^\<ArticleTitle\>/)); 
			# or $_ =~ /^\<DescriptorName\ MajorTopicYN=\"[YN]\"\>/));
		$_ =~ s/\<AbstractText\>//g; 
		$_ =~ s/\<\/AbstractText\>//g;
		$_ =~ s/\<ArticleTitle\>//g; 
		$_ =~ s/\<\/ArticleTitle\>//g;
		$_ =~ s/\<DescriptorName\ MajorTopicYN\=\"Y\"\>//g; 
		$_ =~ s/\<DescriptorName\ MajorTopicYN\=\"N\"\>//g; 
		$_ =~ s/\<\/DescriptorName\>//g;
		my $text = $_; 
		my $id = $file;
		$id =~ s/\.xml//;
		&match ($id, $text, 1);
	}
	close (FD);	
}

sub tag_article{ 
	;
	my ($file) = @_;
	my $path = $file_dir . "/" . $file;
	$file =~ s/\.txt//;

	my $discussion_flag = 0;
	
	open (FD, $path) ||
		die ("Unable to open: $path\n");
	while (<FD>){ 
		chop;
		next if ($_ eq "");
		next if (not $_ =~  /\t/);
		my ($id, $text) = split (/\t/, $_);
	
		if ($_ =~ /\bDiscussion\b/ or $_ =~ /\bDISCUSSION\b/){ 
			$discussion_flag = 1;
		}
	
		if ($discussion_flag == 1 and 
			($_ =~ /\bAcknowledgement\b/ or $_ =~ /\bACKNOWLEDGEMENT\b/ 
			or $_ =~ /\bAcknowledgements\b/ or $_ =~ /\bACKNOWLEDGEMENTS\b/)){ 
			print WR "Encountered aknowledgement at " . $_ . " in $file .. quitting\n";
			last;
		}
		if ($discussion_flag == 1 and 
			($_ =~ /\bReferences\b/ or $_ =~ /\bREFERENCES\b/)){
			print WR "Encountered references at " . $_ . " in $file .. quitting\n";
			last;
		}
		&match ($file, $text, $id);
	}
	close (FD);	
}

sub tag_methods{ 
	;
	my ($file) = @_;
	my $path = $file_dir . "/" . $file;
	$file =~ s/\.txt//;
	open (FD, $path) ||
		die ("Unable to open: $path\n");
	while (<FD>){ 
		chop;
		next if ($_ eq "");
		next if (not $_ =~  /\t/);
		my ($id, $text) = split (/\t/, $_);
		&match ($file, $text, $id);
	}
	close (FD);	
}

sub match_restrictive{ 
	my ($pmid, $text, $id) = @_;
	
	for (my $k = 0; $k < scalar(@dict_words); $k++){
		next if ($dict_words[$k] eq "GTPase");
		if ($term_concepts{$dict_words[$k]} eq "Synonym"){ 
			next if (not $text =~ /\b$dict_words[$k]\b/);
			print_match ($pmid, $id, $dict_words[$k], $text, 1);
		} else { 
			next if (not $text =~ /\b$dict_words[$k]/); 
			print_match ($pmid, $id, $dict_words[$k], $text, 2);
		}
	}	
}

sub match{ 
	my ($pmid, $text, $id) = @_;
	
	for (my $k = 0; $k < scalar(@dict_words); $k++){
		# next if ($dict_words[$k] eq "GTPase");
		if ($dict_words[$k] =~ /^[A-Z]+$/ or length($dict_words[$k]) < 4){ 
			if ($text =~ /\b$dict_words[$k]\b/){
				print_match ($pmid, $id, $dict_words[$k], $text, 1);
			} elsif ($text =~ /\W$dict_words[$k]\W/){ 
				print_match ($pmid, $id, $dict_words[$k], $text, 3);
			} elsif ($text =~ /\b\W*$dict_words[$k]s\W*\b/){ 
				print_match ($pmid, $id, $dict_words[$k], $text, 5);
			} elsif ($text =~ /\b\W*$dict_words[$k]es\W*\b/){ 
				print_match ($pmid, $id, $dict_words[$k], $text, 6);
			}
			next; 
		}

		if ($text =~ /\b$dict_words[$k]\b/){
			print_match ($pmid, $id, $dict_words[$k], $text, 1);
		} elsif ($text =~ /\W$dict_words[$k]\W/){ 
			print_match ($pmid, $id, $dict_words[$k], $text, 3);
		} elsif ($text =~ /\b$dict_words[$k]\W/){ 
			print_match ($pmid, $id, $dict_words[$k], $text, 4);
		} elsif ($text =~ /\b$dict_words[$k]/){ 
			print_match ($pmid, $id, $dict_words[$k], $text, 2);
		} elsif ($text =~ /\b\W*($dict_words[$k])s\W*\b/){ 
			print_match ($pmid, $id, $dict_words[$k], $text, 5);
		} elsif ($text =~ /\b\W*($dict_words[$k])es\W*\b/){ 
			print_match ($pmid, $id, $dict_words[$k], $text, 6);
		} 
	}	
}

sub print_match{ 
	my ($pmid, $sent_id, $term, $text, $regex_id) 
		= @_;
	
	my $confidence = 1;
	my @matches;
	if ($regex_id == 1){
		@matches = ($text =~ /\b$term\b/);
		$confidence = 1;
	} elsif ($regex_id == 2){
		@matches = ($text =~ /\b$term/);
		$confidence = 0.6;
	} elsif ($regex_id == 3){
		@matches = ($text =~ /\W$term\W/);
		$confidence = 1;
	} elsif ($regex_id == 4){
		@matches = ($text =~ /\b$term\W/);
		$confidence = 1;
	} elsif ($regex_id == 5){
		@matches = ($text =~ /\b\W*($term)s\W*\b/);
		$confidence = 1;
	} elsif ($regex_id == 6){
		@matches = ($text =~ /\b\W*($term)es\W*\b/);
		$confidence = 1;
	} 
	
	# If term is GTPase: Low confidence
	# If term is Cd: Low confidence
	if ($term eq "GTPase" or $term eq "gtpase"
		or $term eq "CD" or $term eq "Cd"){ 
		$confidence = 0.3;
	}

	# Extract context 10 words before and after
	my $text_bak = $text;
	my $mod_text = replace_term ($text, $term, $regex_id);
	my $offset = 0;
	my $pos = index ($mod_text, "IMT_INSERT", $offset);
	while ($pos != -1){
		my $start = $pos - 30;
		if ($start < 0){ 
			$start = 0; 
		}
		my $end = $pos + length("IMT_INSERT") + 30;
		if ($end > length($mod_text)){ 
			$end = length($mod_text);
		}	
	
		my $context = "";
		if ($start > 0){ 
			$context .= "..";
		}
	
		# print $regex . "\n";
		# print $text . "\n";
		# print $start . " " . $end . " " . $pos . "\n";	
		$context .= substr($mod_text, $start, $end - $start + 1);
		if ($end < length($mod_text)){ 
			$context .= "..";
		}

		$context =~ s/IMT_INSERT/$term/;
		$context =~ s/\\W/\ /g;

		print $pmid . "\t" . $sent_id . "\t" . $context . "\t" . 
			$term . "\t" . $term_ids{$term} . "\t" . 
			$term_concepts{$term} . "\t" . 
	 		scalar(@matches) . "\t" . $start . "\t" . 
			$end . "\t" . $pos . "\t" . length($term) . "\t" . 
			$confidence . "\n";

		$offset = $pos + length("IMT_INSERT") + 1;
		last if ($offset > length($mod_text));
		$pos = index ($mod_text, "IMT_INSERT", $offset);
	}
}

sub replace_term{
	my ($text, $term, $regex_id) = @_;

	if ($regex_id == 1){
		$text =~ s/\b$term\b/IMT\_INSERT/g;
	} elsif ($regex_id == 2){
		$text =~ s/\b$term/IMT\_INSERT/g;
	} elsif ($regex_id == 3){
		$text =~ s/\W$term\W/IMT\_INSERT/g;
	} elsif ($regex_id == 4){
		$text =~ s/\b$term\W/IMT\_INSERT/g;
	} elsif ($regex_id == 5){
		$text =~ s/\b\W*($term)s\W*\b/IMT\_INSERT/g;
	} elsif ($regex_id == 6){
		$text =~ s/\b\W*($term)es\W*\b/IMT\_INSERT/g;
	}
	return $text; 
}

sub read_dictionary{ 
	;
	open (FD, $dict_file) ||
		die ("Unable to open: $dict_file\n");
	while (<FD>){ 
		chop;
		#MI:0004	affinity chromatography technology	Concept
		my @tfs = split (/\t/, $_);

		if ($tfs[1] =~ /^[A-Z]+$/){ 
			my $term = $tfs[1];
			update_term_arrays ($term, $tfs[2], $tfs[0]);	
			update_term_arrays (lc($term), $tfs[2], $tfs[0]);	
			next;
		} 

		if (not $tfs[1] =~ /\W/){ 
			# print "HERE\n";
			my $term = $tfs[1];
			update_term_arrays ($term, $tfs[2], $tfs[0]);	
		
			#First letter CAPITALIZED	
			$term = $tfs[1];
			if (not $term =~ /^[A-Z]/){ 
				$term = get_capitalized($tfs[1]);
				update_term_arrays (lc($term), $tfs[2], $tfs[0]);	
			}

			# Upper case for lower case
			$term = $tfs[1];
			if ($term =~ /^[a-z0-9]+$/){ 
				update_term_arrays (uc($term), $tfs[2], $tfs[0]);	
			}
			
			# Lower case for upper case
			$term = $tfs[1];
			if ($term =~ /^[A-Z0-9]+$/){ 
				update_term_arrays (lc($term), $tfs[2], $tfs[0]);	
			}
			next;
		}

		# Term AS IT IS
		my $term = $tfs[1];
		$term =~ s/([^a-zA-Z0-9])/\\$1/g;	
		update_term_arrays ($term, $tfs[2], $tfs[0]);	
		
		# Changing - to space and space to -
		$term = $tfs[1];
		if ($term =~ /\-/){ 
			$term =~ s/\-/\ /g;
		} elsif ($term =~ /\ /){ 
			$term =~ s/\ /\-/g;
		}
		$term =~ s/([^a-zA-Z0-9])/\\$1/g;	
		update_term_arrays ($term, $tfs[2], $tfs[0]);	
		
		# removing all non-alphanumeric character
		$term =~ s/([^a-zA-Z0-9])//g;	
		update_term_arrays ($term, $tfs[2], $tfs[0]);	
		
		# First word CAPITALIZED
		$term = $tfs[1];
		$term = get_capitalized ($tfs[1]); 
		$term =~ s/([^a-zA-Z0-9])/\\$1/g;	
		update_term_arrays ($term, $tfs[2], $tfs[0]);	
		
		$term = $tfs[1];
		if ($term =~ /\-/){ 
			$term =~ s/\-/\ /g;
		} elsif ($term =~ /\ /){ 
			$term =~ s/\ /\-/g;
		}
		$term =~ s/([^a-zA-Z0-9])/\\$1/g;	
		update_term_arrays (get_capitalized($term), $tfs[2], $tfs[0]);
			
		# Each word CAPITALIZED
		$term = get_term_capitalized($tfs[1]);
		$term =~ s/([^a-zA-Z0-9])/\\$1/g;	
		update_term_arrays ($term, $tfs[2], $tfs[0]);	
		
		if ($term =~ /\-/){ 
			$term =~ s/\-/\ /g;
		} elsif ($term =~ /\ /){ 
			$term =~ s/\ /\-/g;
		}
		update_term_arrays ($term, $tfs[2], $tfs[0]);	
	}
	close (FD);
}

sub get_term_capitalized{ 
		my ($word) = @_;
	
		my @tokens = split (/[\ \-]/, $word);
		my $separator = " ";
		if ($word =~ /\-/){ 
			$separator = "-";
		}
		my $term = "";
		for (my $i = 0; $i < scalar(@tokens); $i++){ 
			$term .= get_capitalized($tokens[$i]) . $separator;
		}
		$term =~ s/\-$//;
		$term =~ s/\ $//;
		return $term;
}

sub get_capitalized{
		my ($word) = @_;
		return (uc(substr($word, 0, 1)) . 
			substr($word, 1, length($word)-1));
}

sub update_term_arrays{ 
	my ($term, $concept, $id) = @_;	
	
	return if (exists($term_inserted{$term}));
	# print $term . "\n";
	$term_inserted{$term} = 1;
	
	push (@dict_words, $term);
	$id_concept{$id} = $concept;
	
	if (not exists($term_ids{$term})){ 
		$term_ids{$term} = $id; 
	} else { 
		return if ($term_ids{$term} =~ /$id/);  
		$term_ids{$term} .= "," . $id;
	}

	if (not exists($term_concepts{$term})){ 
		$term_concepts{$term} = $concept;
	} else { 
		return if ($term_concepts{$term} =~ /$concept/);  
		$term_concepts{$term} .= "," . $concept;
	}
}

